home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / powertb.arc / WINDOW-3.INC < prev    next >
Encoding:
Text File  |  1986-02-16  |  3.8 KB  |  147 lines
  1. { Turbo Pascal Version 3.0 removable window system
  2.   Copywrite 1984 Michael A. Covington }
  3.  
  4. {===========================================================}
  5. { Modified to speed up screen painting with a color monitor }
  6. { For Turbo Version 3.0 only -- will fail with 2.0 on a     }
  7. { monochrome monitor.                                       }
  8. {===========================================================}
  9.  
  10. { Requirements: IBM PC or close compatible.
  11.   Screen must be in text mode on page 1,
  12.   either mono or color card.
  13.  
  14.   Call INITWIN berfore calling MKWIN or RMWIN
  15. }
  16.  
  17. const maxwin = 5;  { maximum number of windows open at once }
  18.  
  19. type imagetype  = array [1..4096] of char;
  20.      windimtype = record
  21.                      x1,y1,x2,y2: integer
  22.                   end;
  23.  
  24. var win: { global variable package }
  25.         record
  26.           dim:   windimtype;  { current window dimensions }
  27.           depth: integer;
  28.           stack: array [1..maxwin] of
  29.                    record
  30.                      image: imagetype;  { Saved screen attributes }
  31.                      dim:   windimtype; { Saved window dimensions }
  32.                      x,y:   integer;    { Saved cursor position }
  33.                    end
  34.           end;
  35.  
  36.     crtmode:     byte      absolute $0040:$0049;
  37.     crtwidth:    byte      absolute $0040:$004A;
  38.     monobuffer:  imagetype absolute $B000:$0000;
  39.     colorbuffer: imagetype absolute $B800:$0000;
  40.  
  41. {================}
  42. procedure initwin;
  43. {================}
  44.  
  45. { Records initial window dimensions }
  46.  
  47. begin
  48.    with win.dim do
  49.       begin x1:=1; y1:=1; x2 := crtwidth; y2:=25 end;
  50.    win.depth := 0
  51. end;
  52.  
  53. {=====================================}
  54. procedure boxwin(x1,y1,x2,y2: integer);
  55. {=====================================}
  56.  
  57. { Draws a box, fills it with blanks, and makes it the current
  58.   winddow.  Dimensions given are for the box; actual window
  59.   is one unit smaller in each direction.
  60.   This routine can be used seperately from the rest of the
  61.   removable window package.
  62.  
  63.   Modified 2/25/85 by Tryg Helseth to use CLRSCR to
  64.   paint the window.
  65. }
  66. var  x,y:  integer;
  67.  
  68. begin
  69.    window(1,1,80,25);
  70.  
  71.    {top}
  72.    gotoxy(x1,y1);
  73.    write(#213);
  74.    for x:=x1+1 to x2-1 do write(#205);
  75.    write(#184);
  76.  
  77.    {sides}
  78.    for y := y1+1 to y2-1 do begin
  79.       gotoxy(x1,y); write(#179);
  80.       gotoxy(x2,y); write(#179);
  81.       end;
  82.  
  83.    {bottom}
  84.    gotoxy(x1,y2);
  85.    write(#212);
  86.    for x := x1+1 to x2-1 do write(#205);
  87.    write(#190);
  88.  
  89.    {make it the current window}
  90.    window(x1+1,y1+1,x2-1,y2-1);
  91.    clrscr;
  92. end;
  93.  
  94. {===================================}
  95. procedure mkwin(x1,y1,x2,y2:integer);
  96. {===================================}
  97.  
  98. { Create a removable window }
  99.  
  100. begin
  101.    { increment stack pointer }
  102.    with win do depth := depth + 1;
  103.    if win.depth > maxwin then begin
  104.       writeln(^G,' Windows nested too deep ');
  105.       halt
  106.       end;
  107.  
  108.    { save contents of the screen }
  109.    if crtmode = 7 then
  110.       win.stack[win.depth].image := monobuffer
  111.    else
  112.       win.stack[win.depth].image := colorbuffer;
  113.  
  114.    win.stack[win.depth].dim := win.dim;
  115.    win.stack[win.depth].x   := wherex;
  116.    win.stack[win.depth].y   := wherey;
  117.  
  118.    { create the window }
  119.    boxwin(x1,y1,x2,y2);
  120.    win.dim.x1 := x1+1;
  121.    win.dim.y1 := y1+1;
  122.    win.dim.x2 := x2-1;
  123.    win.dim.y2 := y2-1;
  124. end;
  125.  
  126. {==============}
  127. procedure rmwin;
  128. {==============}
  129.  
  130. { Remove the most recently created removable window
  131.   Restore screen contents, winodw dimensions, and
  132.   position of coursor. }
  133.  
  134. begin
  135.    if crtmode = 7 then
  136.      monobuffer := win.stack[win.depth].image
  137.    else
  138.      colorbuffer := win.stack[win.depth].image;
  139.  
  140.    with win do begin
  141.       dim := stack[depth].dim;
  142.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  143.       gotoxy(stack[depth].x,stack[depth].y);
  144.       depth := depth - 1
  145.       end
  146. end;
  147.